home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / LABEL.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-21  |  11KB  |  282 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4. sidesectortrack
  5.  
  6.      This program uses a number of the procedures on this disk to
  7.      find, change, or create a volume label.  You might think you
  8.      could simply FIND it with Find_First (from GETFILE.LIB) and
  9.      change it with a simple RENAME, or create a new file and set
  10.      its attribute to 8 (= Volume label) with FileAttribute (found
  11.      in FILEATTR.LIB.   It ain't that easy!  The only one of the
  12.      routines I just mentioned that will work is Find_First--the
  13.      others are deeply protected agains acting on the LABEL
  14.  
  15.      This being the case, we seek the label by directly reading
  16.      and writing the directory sectors.  It ain't elegant, but
  17.      it does the job.
  18. }
  19.  
  20. {$I regpack.typ}
  21. {$I disktyp.lib}
  22. {$I grfxtabl.lib}
  23. {$I titles.lib}
  24.  
  25. type
  26.   Label_type = string[11];
  27.   directory_entry = record
  28.                       name      : array[1..11] of char; { See the DOS 2.0    }
  29.                       attribute : byte;                 { Manual, Appendix   }
  30.                       junk1     : array[1..10] of byte; { C, for description }
  31.                       time      : array[1..2] of byte;  { of directory.  But }
  32.                       date      : array[1..2] of byte;  { don't look in the  }
  33.                       junk2     : array[1..6] of byte;  { 2.1 Manual--they   }
  34.                     end;                                { took a lot of good }
  35.   buffer_type = array[1..16] of directory_entry;        { stuff out!         }
  36.   sector_loc  = record
  37.                   side, sector, track : byte;
  38.                 end;
  39.  
  40. var
  41.   buffer        : buffer_type;
  42.   drive         : char;
  43.   label_sector, which_entry, free_sector, free_entry  : byte;
  44.   N, M, P, error_return, attrib                       : byte;
  45.   the_label, new_label : label_type;
  46.   dir_sectors          : array[1..7] of sector_loc;
  47.  
  48. {$I getsectr.lib}
  49. var
  50.   OKAY, found : boolean;
  51. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  52. procedure DirectoryMap;                  { This procedure checks what kind  }
  53.   begin                                  { of disk we're looking at and     }
  54.     for N := 1 to 7 do                   { locates the sectors that contain }
  55.       with dir_sectors[N] do             { the directory.                   }
  56.         side := 2;
  57.     case disktype(drive) of
  58.       160: begin
  59.              for N := 1 to 4 do
  60.                with dir_sectors[N] do
  61.                  begin
  62.                    side := 0;
  63.                    track := 0;
  64.                    sector := 3+N;
  65.                  end;
  66.            end;
  67.       180: begin
  68.              for  N := 1 to 4 do
  69.                with dir_sectors[N] do
  70.                  begin
  71.                    side := 0;
  72.                    track := 0;
  73.                    sector := 5+N;
  74.                  end;
  75.            end;
  76.       320: begin
  77.              for N := 1 to 5 do
  78.                with dir_sectors[N] do
  79.                  begin
  80.                    side := 0;
  81.                    track := 0;
  82.                    sector := 3+N;
  83.                  end;
  84.              for N := 6 to 7 do
  85.                with dir_sectors[N] do
  86.                  begin
  87.                    side := 1;
  88.                    track := 0;
  89.                    sector := N-5;
  90.                  end;
  91.            end;
  92.       360: begin
  93.              for N := 1 to 4 do
  94.                with dir_sectors[N] do
  95.                  begin
  96.                    side := 0;
  97.                    track := 0;
  98.                    sector := 5+N;
  99.                  end;
  100.              for N := 5 to 7 do
  101.                with dir_sectors[N] do
  102.                  begin
  103.                    side := 1;
  104.                    track := 0;
  105.                    sector := N-4;
  106.                  end;
  107.            end;
  108.       else
  109.         WriteLn('Non-standard format.  Halting program');
  110.         HALT;
  111.     end; {case}
  112. end; {procedure}
  113. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  114. procedure FindLabel;
  115. begin
  116.   N := 0;
  117.   Free_entry := 0;
  118.   found := false;
  119.   repeat
  120.     N := N + 1;
  121.     if dir_sectors[N].side < 2 then   {if side = 2 here, it means we've
  122.                                        run out of sectors on a single-
  123.                                        sided disk}
  124.       begin
  125.         with dir_sectors[N] do
  126.           begin
  127.             GetSector('R',drive,side,sector,track,OKAY);
  128.                                        { GetSector dumps a sector into
  129.                                          the buffer.  Because the buffer
  130.                                          is "shaped" like a directory, we
  131.                                          have instant access to the dir-
  132.                                          ectory information }
  133.           end;
  134.         if OKAY then
  135.           begin
  136.             for M := 1 to 16 do
  137.               begin
  138.                 with buffer[M] do
  139.                   begin
  140.                     if ((name[1] = #0) or (name[1] = #229))
  141.                        and (Free_Entry = 0) then     { Note the first free   }
  142.                          begin                       { entry--a never-used   }
  143.                            Free_Entry := M;          { one starts w/ chr(0), }
  144.                            Free_Sector := N;         { an erased one, with   }
  145.                          end;                        { chr(229)              }
  146.                     if attribute = 8 then
  147.                       begin                  { Attribute = 8 means we have }
  148.                         Label_sector := N;   { found the label.            }
  149.                         which_entry  := M;
  150.                         found := true;
  151.                         the_label := '';
  152.                         for P := 1 to 11 do
  153.                           the_label := the_label + name[P];
  154.                       end;
  155.                   end;
  156.               end;
  157.           end
  158.         else writeLn('Not OKAY!');
  159.       end;
  160.   until found or (not OKAY) or (dir_sectors[N].side = 2) or (N = 7);
  161. end;
  162. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  163. procedure WriteNewLabel;
  164. begin
  165.   new_label[length(new_label)+1] := #0;
  166.   for P := 1 to 11 do
  167.     buffer[which_entry].name[P] := new_label[P];
  168.   with dir_sectors[label_sector] do
  169.     GetSector('W',drive,side,sector,track,OKAY);
  170.   if OKAY then
  171.     WriteLn('Sucessfully changed label of drive ',drive,' to ',new_label)
  172.   else
  173.     WriteLn('Not OKAY!');
  174. end;
  175. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  176. procedure CreateLabel;
  177. var
  178.   registers : regpack;
  179.   {=================================================}
  180.     procedure GetTime(VAR Byt1,Byt2: byte);
  181.     var
  182.       hours, mins, twoSecs : byte;      { The DOS TIME function delivers }
  183.     begin                               { hours, minutes and seconds in  }
  184.       registers.AX := $2C shl 8;        { one format, but the time info  }
  185.       MSDOS(registers);                 { in the directory is formatted  }
  186.       with registers do                 { quite differently.  The point  }
  187.         begin                           { of all the manipulation and    }
  188.           hours := CX shr 8;            { shifting left and right is to  }
  189.           mins  := CX and $00FF;        { get the time info into this    }
  190.           twoSecs := DX shr 9;          { shape:                         }
  191.         end;                            {  ||  }
  192.                                         {  \/  }
  193. {               high byte                            low byte               }
  194. {bit # 15  14  13  12  11  10   9   8      7   6   5   4   3   2   1   0    }
  195. {     | h   h   h   h   h | m   m   m      m   m   m | s   s   s   s   s |  }
  196. {     |    hour           |    minutes               |   2-seconds       |  }
  197.  
  198.       byt2 := (hours shl 3) + (mins shr 3);
  199.       byt1 := ((mins and 7) shl 5) + twoSecs;
  200.     end;
  201.   {=================================================}
  202.     procedure GetDate(VAR Byt1,Byt2: byte);
  203.     var
  204.       month, day : byte;
  205.       year       : integer;
  206.     begin
  207.       registers.AX := $2A shl 8;
  208.       MSDOS(registers);
  209.       with registers do
  210.         begin
  211.           year := CX;
  212.           month := DX shr 8;
  213.           day   := DX and $00FF;
  214.         end;
  215.  
  216. { The date information in the directory entry is also in an odd format.     }
  217.  
  218. {          high byte                                 low byte               }
  219. {bit # 15  14  13  12  11  10   9   8      7   6   5   4   3   2   1   0    }
  220. {     | y   y   y   y   y   y   y | m      m   m   m | d   d   d   d   d |  }
  221. {     |  year - 1980              |  month (1-12)    |  day (1-31)       |  }
  222.  
  223.       Byt2 := (((Year - 1980) and $00FF) shl 1) + (month shr 3);
  224.       Byt1 := ((month and 7) shl 5) + day;
  225.     end;
  226.   {=================================================}
  227. begin
  228.   WriteLn('Diskette in drive ',drive,' has no label.');
  229.   new_label := '';
  230.   Write('Enter label, or just <return> to quit :');
  231.   ReadLn(new_label);
  232.   if new_label <> '' then
  233.     begin
  234.       with dir_sectors[Free_sector] do                { Get the sector with  }
  235.         GetSector('R',drive,side,sector,track,OKAY);  { the first free entry }
  236.       if OKAY then                                    { back into the buffer }
  237.         begin
  238.           with buffer[Free_Entry] do
  239.             begin
  240.               for N := 1 to length(new_label) do
  241.                 name[N] := new_label[N];
  242.               if length(new_label) < 11 then
  243.                 for N := length(new_label)+1 to 11 do
  244.                   name[N] := ' ';
  245.               attribute := 8;
  246.               for N := 1 to 10 do Junk1[N] := 0;
  247.               GetTime(time[1],time[2]);
  248.               GetDate(date[1],date[2]);
  249.               for N := 1 to 6 do Junk2[N] := 0;
  250.             end;  {with}
  251.           with dir_sectors[Free_sector] do
  252.             GetSector('W',drive,side,sector,track,OKAY);
  253.           if OKAY then
  254.             WriteLn('Sucessfully created label ',new_label,' for drive ',drive);
  255.         end;  { if OKAY}
  256.     end; {if not = ''}
  257. end;
  258. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  259. begin
  260.   MakeTitle('LABEL',1);   { This procedure is in TITLES.LIB }
  261.   window(1,10,80,25);
  262.   ClrScr;
  263.   repeat
  264.     gotoXY(1,WhereY); ClrEOL;
  265.     Write('Which drive? ');
  266.     Read(drive);
  267.     drive := UpCase(drive);
  268.   until drive in ['A'..'D'];
  269.   WriteLn;
  270.   DirectoryMap;
  271.   FindLabel;
  272.   if found then
  273.     begin
  274.       WriteLn('Current label is ',the_label);
  275.       new_label := '';
  276.       Write('Enter new label, or <return> to leave alone: ');
  277.       readLn(new_label);
  278.       if new_label <> '' then WriteNewLabel;
  279.     end
  280.   else CreateLabel;
  281. end.
  282.